(FILECREATED "24-FEB-83 11:26:22" {PHYLUM}<GABRIEL>PUZZLE.;6 5683   

      changes to:  (VARS TYPEMAX)
		   (FNS FIT PLACE REMOVE! TRIAL START DEFINEPIECE FRESHPUZZLES)

      previous date: "17-FEB-83 10:03:35" {PHYLUM}<GABRIEL>PUZZLE.;4)

(* 1-BASED, INTERLISP ARRAYS)

(* Copyright (c) 1982, 1983 by Xerox Corporation)

(PRETTYCOMPRINT PUZZLECOMS)

(RPAQQ PUZZLECOMS (
		   (CONSTANTS SIZE TYPEMAX D CLASSMAX P-MULT)
		   (FNS FIT PLACE REMOVE! TRIAL DEFINEPIECE START FRESHPUZZLES)
		   (BLOCKS
 		    (PUZZLEBLOCK
		     FIT PLACE REMOVE! TRIAL DEFINEPIECE START FRESHPUZZLES
		     (SPECVARS KOUNT)
		     (ENTRIES 
		      START FRESHPUZZLES)))
		   (MACROS CLASS PIECEMAX PUZZLE P PIECECOUNT)
		   (INITVARS (CLASS NIL)
			     (PIECEMAX NIL)
			     (PUZZLE NIL)
			     (P NIL)
			     (PIECECOUNT NIL)
			     (PUZZLETRACEFLG NIL))
		   (GLOBALVARS CLASS PIECEMAX PUZZLE P PIECECOUNT III PUZZLETRACEFLG)
		   (SPECVARS KOUNT)
		   (P (FRESHPUZZLES))))
(DECLARE: EVAL@COMPILE 

(RPAQQ SIZE 511)

(RPAQQ TYPEMAX 13)

(RPAQQ D 8)

(RPAQQ CLASSMAX 3)

(CONSTANTS SIZE TYPEMAX D CLASSMAX)
)
(DEFINEQ

(FIT
  (LAMBDA (I J)                                              (* JonL "16-FEB-83 14:50")
    (NOT (find K from 0 to (PIECEMAX I) suchthat (AND (P I (ADD1 K))
						      (PUZZLE (IPLUS J K)))))))

(PLACE
  (LAMBDA (I J)                                              (* JonL "16-FEB-83 21:07")
    (for K from 0 to (PIECEMAX I) do (if (P I (ADD1 K))
					 then (SETA PUZZLE (IPLUS J K) T)))
    (SETA
     PIECECOUNT
     (CLASS I)
     (SUB1 (PIECECOUNT (CLASS I))))
    (OR (find K from J to SIZE suchthat (NOT (PUZZLE K)))
	1)))

(REMOVE!
  (LAMBDA (I J)                                              (* JonL "16-FEB-83 21:07")
    (for K from 0 to (PIECEMAX I) do (if (P I (ADD1 K))
					 then (SETA PUZZLE (IPLUS J K) NIL)))
    (SETA
     PIECECOUNT
     (CLASS I)
     (ADD1 (PIECECOUNT (CLASS I))))))

(TRIAL
  (LAMBDA (J)                                                (* edited: "17-FEB-83 10:02")
    (bind (K ← 1) for I from 1 to TYPEMAX
       do (if (AND (NEQ 0 (PIECECOUNT (CLASS I)))
		   (FIT I J))
	      then (SETQ K (PLACE I J))
		   (if (OR (TRIAL K)
			   (EQ 1  K))
		       then (AND PUZZLETRACEFLG (printout NIL T "Piece" .TAB 
							  (ADD1 I) .TAB "at" .TAB (ADD1 K)))
			    (add KOUNT 1)
			    (RETURN T)
		     else (REMOVE! I J)))
       finally (PROGN (add KOUNT 1)
		      NIL))))

(DEFINEPIECE
  (LAMBDA (ICLASS II JJ KK)                                  (* JonL "16-FEB-83 17:15")
    (PROG ((INDEX 1))
          (for I from 0 to II do (for J from 0 to JJ
				    do (for K from 0 to KK
					  do (SETQ INDEX 
						   (ADD1 
						    (IPLUS I 
							   (ITIMES D 
								   (IPLUS J
									  (ITIMES D K))))))
					     (SETA P (IPLUS III (ITIMES P-MULT (SUB1 INDEX)))
						   T))))
          (SETA CLASS III ICLASS)
          (SETA PIECEMAX III INDEX )
          (if (NEQ III TYPEMAX)
	      then (add III 1)))))

(START
  (LAMBDA NIL                                                (* JonL "16-FEB-83 22:21")
    (for M from 1 to (ADD1 SIZE) do (SETA PUZZLE M T))
    (for I from 1 to 5 do (for J from 1 to 5
			     do (for K from 1 to 5
				   do (SETA PUZZLE (ADD1 (IPLUS I (ITIMES D (IPLUS J (ITIMES D K))))) NIL)))
	 )
    (for I from 1 to TYPEMAX do (for M from 1 to (ADD1 SIZE) do 
				     (SETA P (IPLUS I (ITIMES P-MULT (SUB1 M))) NIL)))
    (SETQ III 1)
    (DEFINEPIECE 1 3 1 0)
    (DEFINEPIECE 1 1 0 3)
    (DEFINEPIECE 1 0 3 1)
    (DEFINEPIECE 1 1 3 0)
    (DEFINEPIECE 1 3 0 1)
    (DEFINEPIECE 1 0 1 3)
    (DEFINEPIECE 2 2 0 0)
    (DEFINEPIECE 2 0 2 0)
    (DEFINEPIECE 2 0 0 2)
    (DEFINEPIECE 3 1 1 0)
    (DEFINEPIECE 3 1 0 1)
    (DEFINEPIECE 3 0 1 1)
    (DEFINEPIECE 4 1 1 1)
    (SETA PIECECOUNT 1 13)
    (SETA PIECECOUNT 2 3)
    (SETA PIECECOUNT 3 1)
    (SETA PIECECOUNT 4 1)
    (PROG ((M (IPLUS 2 (ITIMES D (IPLUS 1 D))))
	   (N 1)
	   (KOUNT 0))
          (if (FIT 1 M)
	      then (SETQ N (PLACE 1 M))
	    else (printout NIL T "Error"))
          (if (TRIAL N)
	      then (printout NIL T "Success in " KOUNT " trials.")
	    else (printout NIL T "Failure."))
          (TERPRI))))

(FRESHPUZZLES
  (LAMBDA NIL                                                (* JonL "16-FEB-83 21:12")
    (SETQ CLASS (ARRAY TYPEMAX))
    (SETQ PIECEMAX (ARRAY TYPEMAX))
    (SETQ PUZZLE (ARRAY (IPLUS SIZE 2))) 
    (SETQ P (ARRAY (ITIMES TYPEMAX
			   (IPLUS SIZE 1))))
    (SETQ PIECECOUNT (ARRAY (IPLUS CLASSMAX 1)))
    NIL))
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS CLASS MACRO ((I)
  (ELT CLASS I)))

(PUTPROPS PIECEMAX MACRO ((I)
  (ELT PIECEMAX I)))

(PUTPROPS PUZZLE MACRO ((I)
  (ELT PUZZLE I)))

(PUTPROPS P MACRO ((I J)
  (ELT P (IPLUS (ITIMES (SUB1 J) P-MULT) I))))

(PUTPROPS PIECECOUNT MACRO ((I)
  (ELT PIECECOUNT I)))
)

(RPAQ? CLASS NIL)

(RPAQ? PIECEMAX NIL)

(RPAQ? PUZZLE NIL)

(RPAQ? P-MULT TYPEMAX)

(RPAQ? P NIL)

(RPAQ? PIECECOUNT NIL)

(RPAQ? PUZZLETRACEFLG NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS CLASS PIECEMAX PUZZLE P PIECECOUNT III PUZZLETRACEFLG)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(SPECVARS KOUNT)
)
(FRESHPUZZLES)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1003 4888 (FIT 1013 . 1229) (PLACE 1231 . 1602) (REMOVE! 1604 . 1901) (TRIAL 1903 . 
2464) (DEFINEPIECE 2466 . 2989) (START 2991 . 4348) (FRESHPUZZLES 4350 . 4886)))))
STOP